Итак, начну с загрузки пакетов. Их будет много.

Packages <- c("tidyverse", "tseries", "caret", "ggpubr", "stats", "corrplot", "GGally", "rstatix", "colorspace", "sandwich", "lmtest")
lapply(Packages, library, character.only = TRUE)
## -- Attaching packages --------------------------------------- tidyverse 1.3.1 --
## v ggplot2 3.3.5     v purrr   0.3.4
## v tibble  3.1.6     v dplyr   1.0.8
## v tidyr   1.2.0     v stringr 1.4.0
## v readr   2.1.2     v forcats 0.5.1
## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()
## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo
## Loading required package: lattice
## 
## Attaching package: 'caret'
## The following object is masked from 'package:purrr':
## 
##     lift
## corrplot 0.92 loaded
## Registered S3 method overwritten by 'GGally':
##   method from   
##   +.gg   ggplot2
## 
## Attaching package: 'rstatix'
## The following object is masked from 'package:stats':
## 
##     filter
## Loading required package: zoo
## 
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
## [[1]]
##  [1] "forcats"   "stringr"   "dplyr"     "purrr"     "readr"     "tidyr"    
##  [7] "tibble"    "ggplot2"   "tidyverse" "stats"     "graphics"  "grDevices"
## [13] "utils"     "datasets"  "methods"   "base"     
## 
## [[2]]
##  [1] "tseries"   "forcats"   "stringr"   "dplyr"     "purrr"     "readr"    
##  [7] "tidyr"     "tibble"    "ggplot2"   "tidyverse" "stats"     "graphics" 
## [13] "grDevices" "utils"     "datasets"  "methods"   "base"     
## 
## [[3]]
##  [1] "caret"     "lattice"   "tseries"   "forcats"   "stringr"   "dplyr"    
##  [7] "purrr"     "readr"     "tidyr"     "tibble"    "ggplot2"   "tidyverse"
## [13] "stats"     "graphics"  "grDevices" "utils"     "datasets"  "methods"  
## [19] "base"     
## 
## [[4]]
##  [1] "ggpubr"    "caret"     "lattice"   "tseries"   "forcats"   "stringr"  
##  [7] "dplyr"     "purrr"     "readr"     "tidyr"     "tibble"    "ggplot2"  
## [13] "tidyverse" "stats"     "graphics"  "grDevices" "utils"     "datasets" 
## [19] "methods"   "base"     
## 
## [[5]]
##  [1] "ggpubr"    "caret"     "lattice"   "tseries"   "forcats"   "stringr"  
##  [7] "dplyr"     "purrr"     "readr"     "tidyr"     "tibble"    "ggplot2"  
## [13] "tidyverse" "stats"     "graphics"  "grDevices" "utils"     "datasets" 
## [19] "methods"   "base"     
## 
## [[6]]
##  [1] "corrplot"  "ggpubr"    "caret"     "lattice"   "tseries"   "forcats"  
##  [7] "stringr"   "dplyr"     "purrr"     "readr"     "tidyr"     "tibble"   
## [13] "ggplot2"   "tidyverse" "stats"     "graphics"  "grDevices" "utils"    
## [19] "datasets"  "methods"   "base"     
## 
## [[7]]
##  [1] "GGally"    "corrplot"  "ggpubr"    "caret"     "lattice"   "tseries"  
##  [7] "forcats"   "stringr"   "dplyr"     "purrr"     "readr"     "tidyr"    
## [13] "tibble"    "ggplot2"   "tidyverse" "stats"     "graphics"  "grDevices"
## [19] "utils"     "datasets"  "methods"   "base"     
## 
## [[8]]
##  [1] "rstatix"   "GGally"    "corrplot"  "ggpubr"    "caret"     "lattice"  
##  [7] "tseries"   "forcats"   "stringr"   "dplyr"     "purrr"     "readr"    
## [13] "tidyr"     "tibble"    "ggplot2"   "tidyverse" "stats"     "graphics" 
## [19] "grDevices" "utils"     "datasets"  "methods"   "base"     
## 
## [[9]]
##  [1] "colorspace" "rstatix"    "GGally"     "corrplot"   "ggpubr"    
##  [6] "caret"      "lattice"    "tseries"    "forcats"    "stringr"   
## [11] "dplyr"      "purrr"      "readr"      "tidyr"      "tibble"    
## [16] "ggplot2"    "tidyverse"  "stats"      "graphics"   "grDevices" 
## [21] "utils"      "datasets"   "methods"    "base"      
## 
## [[10]]
##  [1] "sandwich"   "colorspace" "rstatix"    "GGally"     "corrplot"  
##  [6] "ggpubr"     "caret"      "lattice"    "tseries"    "forcats"   
## [11] "stringr"    "dplyr"      "purrr"      "readr"      "tidyr"     
## [16] "tibble"     "ggplot2"    "tidyverse"  "stats"      "graphics"  
## [21] "grDevices"  "utils"      "datasets"   "methods"    "base"      
## 
## [[11]]
##  [1] "lmtest"     "zoo"        "sandwich"   "colorspace" "rstatix"   
##  [6] "GGally"     "corrplot"   "ggpubr"     "caret"      "lattice"   
## [11] "tseries"    "forcats"    "stringr"    "dplyr"      "purrr"     
## [16] "readr"      "tidyr"      "tibble"     "ggplot2"    "tidyverse" 
## [21] "stats"      "graphics"   "grDevices"  "utils"      "datasets"  
## [26] "methods"    "base"

А теперь и сам датасет. Это отзывы на винишко со всего мира. Датасет включает в себя страну, регион (как сам регион, так и аппеласьон), собсвенно отзыв, оценку по 100-балльной шкале, цену в долларах, имя сомелье и его твиттер. Во всех столбцах, кроме отзыва и оценки есть пропуски

wine <- read_csv('/Users/pitikov_egor/Desktop/winemag-data-130k-v2.csv')
## New names:
## * `` -> ...1
## Rows: 129971 Columns: 14
## -- Column specification --------------------------------------------------------
## Delimiter: ","
## chr (11): country, description, designation, province, region_1, region_2, t...
## dbl  (3): ...1, points, price
## 
## i Use `spec()` to retrieve the full column specification for this data.
## i Specify the column types or set `show_col_types = FALSE` to quiet this message.
wine

Просто посмотреть зависимость всего от всего ничего не дало (исключены пункиы с огромным колечеством значений). Ну то есть дало понимание, что надо копать глубже…

wine_sub <- subset(wine, select = -c(1, description, designation, province, region_1, region_2, title, variety, winery, taster_twitter_handle))
ggpairs(wine_sub, cardinality_threshold = 45, upper = list(continuous = wrap("cor", method = "spearman")))+
  theme(axis.text.x = element_text(angle = 90, hjust = 1, size = 4), axis.text.y = element_text(size = 4))
## Warning: Removed 63 rows containing missing values (stat_boxplot).
## Removed 63 rows containing missing values (stat_boxplot).
## Warning: Removed 8992 rows containing non-finite values (stat_boxplot).
## Warning: Removed 63 rows containing non-finite values (stat_g_gally_count).
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning in ggally_statistic(data = data, mapping = mapping, na.rm = na.rm, :
## Removed 8996 rows containing missing values
## Warning in cor.test.default(x, y, method = method, use = use): Cannot compute
## exact p-value with ties
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: Removed 8996 rows containing non-finite values (stat_bin).
## Warning: Removed 8996 rows containing missing values (geom_point).
## Warning: Removed 8996 rows containing non-finite values (stat_density).
## Warning: Removed 8996 rows containing non-finite values (stat_boxplot).
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: Removed 8996 rows containing non-finite values (stat_bin).

Для начала самое логичное - корреляция оценки и стоимости. Заметно, что данные скоррелированы, однако есть сильные выбросы. Да и стобалльное вино можно найти с 250 баксов, что не может не радовать. Однако линейную регрессию построить не получится - дисперсия на протяжении линии тренда различна. Возможно, это объясняется регионом производсва вина (брендовой накруткой стоимости)

as <- ggplot(wine, aes(x=price, y=points)) + 
  geom_point(aes(color = country)) + 
  stat_smooth(method = lm, se = T) + 
  ylim(75, 101) + 
  xlim(0, 1000)
ns <- ggplot(wine, aes(x=price, y=points)) + 
  geom_point(aes(color = country)) + 
  stat_smooth(method = lm, se = T) + 
  ylim(75, 101) +
  ggtitle("Plot of points by price")
as
## `geom_smooth()` using formula 'y ~ x'
## Warning: Removed 9010 rows containing non-finite values (stat_smooth).
## Warning: Removed 9010 rows containing missing values (geom_point).
## Warning: Removed 52 rows containing missing values (geom_smooth).

ns
## `geom_smooth()` using formula 'y ~ x'
## Warning: Removed 8996 rows containing non-finite values (stat_smooth).
## Warning: Removed 8996 rows containing missing values (geom_point).
## Warning: Removed 69 rows containing missing values (geom_smooth).

Для проверки корреляции стоимости и рейтинга был применен тест спирмана. 0,6 довольно неплохая корреляция, а p-value указывает на ее значимость. Что ж, видимо, за хорошее вино надо платить.

a <- cor.test(wine$points, wine$price, method = 'spearman')
## Warning in cor.test.default(wine$points, wine$price, method = "spearman"):
## Cannot compute exact p-value with ties
a
## 
##  Spearman's rank correlation rho
## 
## data:  wine$points and wine$price
## S = 1.1632e+14, p-value < 2.2e-16
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
##       rho 
## 0.6057853

Были построены гистограммы и функции распредения для оценок и стоимости. обе нормальными можно назвать с натяжкой, а значит, в дальнейшем в приоритете ранговые методы

g1 <- ggplot(wine, aes(price)) +
  geom_histogram(aes(y = after_stat(density)),
                 position = 'identity') + 
  geom_density(bw = 8, alpha = 8) +
  xlim(0, 200) +
  ggtitle("Histogramm of price")
g2 <- ggplot(wine, aes(points)) +
  geom_histogram(aes(y = after_stat(density), binwidth=0.5),
                 position = 'identity') + 
  geom_density(bw = 8, alpha = 8) +
  xlim(70, 101) + 
  scale_x_continuous(breaks = seq(70, 101, by = 5)) +
  ggtitle("Histogramm of scores")
## Warning: Ignoring unknown aesthetics: binwidth
## Scale for 'x' is already present. Adding another scale for 'x', which will
## replace the existing scale.
#ggarrange(g1, g2 + rremove("x.text"), 
 #         labels = c("A", "B"),
  #        ncol = 2, nrow = 1, vjust = 10, align = "v", widths = 1, heights = c(4, 4))
g1
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: Removed 9678 rows containing non-finite values (stat_bin).
## Warning: Removed 9678 rows containing non-finite values (stat_density).
## Warning: Removed 2 rows containing missing values (geom_bar).

g2
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Для проверки на нормальность был использован тест харки-бера. Даже он будет давать ошибки первого рода на таких данных, но чем богаты… Оба распредения значимо отличаются от нормального

x <- as.numeric(wine$points)
x <- x[!is.na(x)]
f <- jarque.bera.test(x)
f
## 
##  Jarque Bera Test
## 
## data:  x
## X-squared = 520.15, df = 2, p-value < 2.2e-16
y <- as.numeric(wine$price)
y <- x[!is.na(y)]
q <- jarque.bera.test(y)
q
## 
##  Jarque Bera Test
## 
## data:  y
## X-squared = 460.29, df = 2, p-value < 2.2e-16

Для оценки различий по стране-проихводителю был построен боксплот и посчитан тест круская уоллиса. Вина из разных стран значимо отличаются, в топе Чехия и Австрия.

ggplot(wine, aes(y=points, fill=country)) + 
  geom_boxplot()+
  theme(axis.text.x=element_text(angle =- 90, vjust = 0.5))+
  ggtitle("Boxplot scores to country")

c <- wine %>% drop_na(country) %>% kruskal.test(points ~ country)
## Warning in kruskal.test.default(., points ~ country): 'x' is a list, so ignoring
## argument 'g'
## Warning in kruskal.test.default(., points ~ country): some elements of 'x' are
## not numeric and will be coerced to numeric
c
## 
##  Kruskal-Wallis rank sum test
## 
## data:  .
## Kruskal-Wallis chi-squared = 1060085, df = 13, p-value < 2.2e-16

Так-так. Вроде как Чехия и Австрия в лидерах не только по производству пива, но и вина тоже. Чтобы проверить значимость различий между станами использован тест Данна. И тут выяснилось, что отличия у Чехии не особо значимы… Да и вообще хорошо отличаются только лидеры от аутсайдеров… Что ж, +- все вино из примерно топ-10 стран-прозводителей получило статистически неразличимые отличия и, кажется, чешское вино не стоит таких денег, как на полках в SimpleWine. (Стало грустно за потраченное…)

test_res <- wine %>% dunn_test(points ~ country, p.adjust.method = "holm") %>% select(group1, group2, p.adj)
ggplot(test_res, aes(group1, group2)) + geom_tile(aes(fill = p.adj)) + theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1, size = 6), axis.text.y = element_text(size = 6), panel.grid.major = element_blank(), panel.grid.minor = element_blank()) + ggtitle("Heatmap of Dunn pvals")

c <- wine %>% drop_na(country) %>% kruskal.test(points ~ country)
## Warning in kruskal.test.default(., points ~ country): 'x' is a list, so ignoring
## argument 'g'
## Warning in kruskal.test.default(., points ~ country): some elements of 'x' are
## not numeric and will be coerced to numeric
c
## 
##  Kruskal-Wallis rank sum test
## 
## data:  .
## Kruskal-Wallis chi-squared = 1060085, df = 13, p-value < 2.2e-16

Чтобы выяснить ценовые предпочтения сомелье был также построен боксплот и проведен тест круская уоллиса. Сомелье пьют вино их разных ценовых категорий с очень большой значимостью. Это плохо, так как будет вносить дополнительный биас.

ggplot(wine, aes(y=price, x=taster_name, fill=taster_name)) + 
  geom_boxplot()+
  theme(axis.text.x=element_text(angle =- 90, vjust = 0.5))+
  ylim(0, 250)+
  ggtitle("Boxplot price to taster_name")
## Warning: Removed 9450 rows containing non-finite values (stat_boxplot).

Чтобы проверить, кто именно из критиков от кого отличается использован тест Данна - он сохраняет ранжирование и использует дисперсионную оценку, полученную в тесте Краскелла Уолиса. Оп-ля. Оказывается, есть группы критиков, пьющие винишко из схожих ценовых категорий. Это хорошо, можно читать их отзывы и выбирать что-то прекрасно-фруктовое, приятно-танниновое, отметая откровенно плозие варианты. Или нет?

test_res <- wine %>% dunn_test(price ~ taster_name, p.adjust.method = "holm") %>% select(group1, group2, p.adj)
ggplot(test_res, aes(group1, group2)) + geom_tile(aes(fill = p.adj)) + theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1), panel.grid.major = element_blank(), panel.grid.minor = element_blank()) + ggtitle("Heatmap of Dunn pvals price of tasters")

c <- wine %>% drop_na(taster_name, price) %>% kruskal.test(price ~ taster_name)
## Warning in kruskal.test.default(., price ~ taster_name): 'x' is a list, so
## ignoring argument 'g'
## Warning in kruskal.test.default(., price ~ taster_name): some elements of 'x'
## are not numeric and will be coerced to numeric
c
## 
##  Kruskal-Wallis rank sum test
## 
## data:  .
## Kruskal-Wallis chi-squared = 829175, df = 13, p-value < 2.2e-16

Так. Есть понимание, что медианы различны. НО может между сомелье они похожи? Тест Данна может показать, где именно наблюдается различие

Следующим шагом стало создание боксплота оценок в зависимости от сомелье и проверка его тем же тестом круская. Оченки у критиков также разнятся, что вносит еще один биас.

ggplot(wine, aes(y=points, x=taster_name, fill=taster_name)) + 
  geom_boxplot()+
  theme(axis.text.x=element_text(angle =- 90, vjust = 0.5))+
  ylim(70, 101)+
  ggtitle("Boxplot score to taster_name")

c <- wine %>% drop_na(country) %>% kruskal.test(points ~ taster_name)
## Warning in kruskal.test.default(., points ~ taster_name): 'x' is a list, so
## ignoring argument 'g'
## Warning in kruskal.test.default(., points ~ taster_name): some elements of 'x'
## are not numeric and will be coerced to numeric
c
## 
##  Kruskal-Wallis rank sum test
## 
## data:  .
## Kruskal-Wallis chi-squared = 1060085, df = 13, p-value < 2.2e-16

ТАК. А может, все-таки есть просто группы критиков с похожей медианой оценки? Снова Данн и хитмап похож на хитмап по ценам! Да, все-таки у похожих ценовых диапазонов схожие оценки, за несколькими исключениями (Поль Грегут, например, перестает коррелировать с Кэрри Дайксом, хоть Дайкс и не теряет всех коррелций). Интересно… Однако в большинсве своем сомелье не нашли согласия - кажеся, цена роляет.

test_res <- wine %>% dunn_test(points ~ taster_name, p.adjust.method = "holm") %>% select(group1, group2, p.adj)
ggplot(test_res, aes(group1, group2)) + geom_tile(aes(fill = p.adj)) + theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1), panel.grid.major = element_blank(), panel.grid.minor = element_blank()) + ggtitle("Heatmap of Dunn pvals points of tasters")

Чтобы проверить, насколько сомелье привязаны к какой-либо стране, был проведен точный тест фишера. И да, величины страна-критик зависимы. А это еще один неучтенный биас…

wine %>% drop_na(taster_name, country) %>% group_by(taster_name, country) %>%summarise(count = n())
## `summarise()` has grouped output by 'taster_name'. You can override using the
## `.groups` argument.
wine_grouped <- wine %>% drop_na(taster_name, country) %>% group_by(taster_name, country) %>%summarise(count = n())%>% pivot_wider(names_from = taster_name, values_from = count)
## `summarise()` has grouped output by 'taster_name'. You can override using the
## `.groups` argument.
wine_grouped[is.na(wine_grouped)] <- 0
## Warning in do.call("cbind", lapply(x, "is.na")): unable to translate 'Anne
## Krebiehl<U+00A0>MW' to native encoding
## Warning in do.call("cbind", lapply(x, "is.na")): unable to translate 'Kerin
## O<U+2019>Keefe' to native encoding
f.res <- fisher.test(wine_grouped[2:20], simulate.p.value = TRUE, B = 10000)
f.res
## 
##  Fisher's Exact Test for Count Data with simulated p-value (based on
##  10000 replicates)
## 
## data:  wine_grouped[2:20]
## p-value = 9.999e-05
## alternative hypothesis: two.sided

Далее было посчитано число слов в каждом отзыве

wine$total <- sapply(wine$description, function(x) length(unlist(strsplit(as.character(x), "\\W+"))))
wine

На скаттерплоте отобрадена зависимость числа слов от оценки. Про любимое вино больше пишут - логично. А тест Спирмана нашел неплохую корреляцию между размером отзыва и оценкой.

as <- ggplot(wine, aes(x=total, y=points)) + 
  geom_point(aes(color = taster_name)) + 
  stat_smooth(method = lm, se = T) + ggtitle("Plot of points by total words")
as
## `geom_smooth()` using formula 'y ~ x'

a <- cor.test(wine$points, wine$total, method = 'spearman')
## Warning in cor.test.default(wine$points, wine$total, method = "spearman"):
## Cannot compute exact p-value with ties
a
## 
##  Spearman's rank correlation rho
## 
## data:  wine$points and wine$total
## S = 1.8031e+14, p-value < 2.2e-16
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
##       rho 
## 0.5072382
test_res <- wine %>% dunn_test(total ~ taster_name, p.adjust.method = "holm") %>% select(group1, group2, p.adj)
ggplot(test_res, aes(group1, group2)) + geom_tile(aes(fill = p.adj)) + theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1, size = 6), axis.text.y = element_text(size = 6), panel.grid.major = element_blank(), panel.grid.minor = element_blank()) + ggtitle("Heatmap of Dunn pvals of total between somelje")

Далее было проверено, не отличаются ли по длине отзывы у разных сомелье. Отличаются, о чем говорит p-value теста Круская-Уоллиса

ggplot(wine, aes(y=total, x=taster_name, fill=taster_name)) + 
  geom_boxplot()+
  theme(axis.text.x=element_text(angle =- 90, vjust = 0.5))+
  ylim(0, 250)

c <- wine %>% drop_na(taster_name) %>% kruskal.test(total ~ taster_name)
## Warning in kruskal.test.default(., total ~ taster_name): 'x' is a list, so
## ignoring argument 'g'
## Warning in kruskal.test.default(., total ~ taster_name): some elements of 'x'
## are not numeric and will be coerced to numeric
c
## 
##  Kruskal-Wallis rank sum test
## 
## data:  .
## Kruskal-Wallis chi-squared = 1034177, df = 14, p-value < 2.2e-16
g1 <- ggplot(wine, aes(total)) +
  geom_histogram(aes(y = after_stat(density)),
                 position = 'identity') + 
  geom_density(bw = 8, alpha = 8) +
  xlim(0, 200) +
  ggtitle("Histogramm of price")
g1
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: Removed 2 rows containing missing values (geom_bar).

x <- as.numeric(wine$total)
x <- x[!is.na(x)]
f <- jarque.bera.test(x)
f
## 
##  Jarque Bera Test
## 
## data:  x
## X-squared = 16531, df = 2, p-value < 2.2e-16

Была построена линейная регрессия оценки вина от числа слов в отзыве с учетом сомелье.Ибо распреления все-таки близки к нормальным, НО из-зи большого числа наблюдений чувствительность тестов многократно вохрастает. И она очень хорошо объясняет наблюдаемые зависимости. Кажется, что число слов в отзыве вообще один из самых лучших показателей хорошего вина - выбросы реже, чем по стоимости, стабильнее и так далее… На qq плоте звметно, что распредение остатков близко к нормальному. Из неприятного данные не совсем гомоскедаксичны, то есть доверительные интервалы для прогнозов надо считать довольно сложным образом мммм… тест Уайта или Голдфельда для ошибок. (Если присутсвует условная гетероскедаксичность, то есть и безусловная гомоскедаксичность - модель сохраняет силу! Объясняется это тем, что все пишут число слов близкое к среднему. И все-таки довольно редко (относительно) появляются отзывы в пару предоложений или “война и мир” на 100500 страниц (но читать интересно - я про отзывы на винишко). Ну, или можно немного поправить. Постараться.

Собственно, значимость коэффицентов приведена ниже. Нетрудно заметить, что это хороший предиктор не для всех сомелье, но для многих

total_to_points <- lm(points ~ total*taster_name, wine)
summary(total_to_points)
## 
## Call:
## lm(formula = points ~ total * taster_name, data = wine)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -13.7851  -1.6321  -0.0359   1.5946  10.8095 
## 
## Coefficients:
##                                           Estimate Std. Error t value Pr(>|t|)
## (Intercept)                              82.103821   0.376073 218.319  < 2e-16
## total                                     0.093711   0.008924  10.501  < 2e-16
## taster_nameAnna Lee C. Iijima             1.307893   0.418147   3.128 0.001761
## taster_nameAnne Krebiehl<U+00A0>MW        3.293674   0.397597   8.284  < 2e-16
## taster_nameCarrie Dykes                   1.856185   1.027915   1.806 0.070956
## taster_nameChristina Pickard             -7.098398   5.248603  -1.352 0.176239
## taster_nameFiona Adams                    1.073617   2.212036   0.485 0.627427
## taster_nameJeff Jenssen                   3.027258   0.594278   5.094 3.51e-07
## taster_nameJim Gordon                    -0.210811   0.404845  -0.521 0.602563
## taster_nameJoe Czerwinski                 1.107008   0.399379   2.772 0.005575
## taster_nameKerin O<U+2019>Keefe           0.664343   0.390642   1.701 0.089013
## taster_nameLauren Buzzeo                 -1.285158   0.428298  -3.001 0.002695
## taster_nameMatt Kettmann                  0.508493   0.413603   1.229 0.218916
## taster_nameMichael Schachner             -2.530613   0.386700  -6.544 6.01e-11
## taster_nameMike DeSimone                  3.613671   0.655955   5.509 3.62e-08
## taster_namePaul Gregutt                   2.662007   0.385890   6.898 5.29e-12
## taster_nameRoger Voss                     0.674660   0.380820   1.772 0.076464
## taster_nameSean P. Sullivan               2.830348   0.392619   7.209 5.68e-13
## taster_nameSusan Kostrzewa                2.322982   0.514182   4.518 6.25e-06
## taster_nameVirginie Boone                 0.903723   0.387870   2.330 0.019810
## total:taster_nameAnna Lee C. Iijima       0.026245   0.009904   2.650 0.008052
## total:taster_nameAnne Krebiehl<U+00A0>MW  0.015100   0.009291   1.625 0.104132
## total:taster_nameCarrie Dykes            -0.037369   0.023394  -1.597 0.110184
## total:taster_nameChristina Pickard        0.246853   0.136834   1.804 0.071228
## total:taster_nameFiona Adams             -0.011437   0.048066  -0.238 0.811917
## total:taster_nameJeff Jenssen            -0.005446   0.015262  -0.357 0.721203
## total:taster_nameJim Gordon               0.070939   0.009604   7.386 1.52e-13
## total:taster_nameJoe Czerwinski           0.030473   0.009426   3.233 0.001226
## total:taster_nameKerin O<U+2019>Keefe     0.059629   0.009293   6.417 1.40e-10
## total:taster_nameLauren Buzzeo            0.047765   0.009792   4.878 1.07e-06
## total:taster_nameMatt Kettmann            0.056034   0.009561   5.861 4.62e-09
## total:taster_nameMichael Schachner        0.073514   0.009146   8.038 9.23e-16
## total:taster_nameMike DeSimone           -0.020822   0.014439  -1.442 0.149298
## total:taster_namePaul Gregutt             0.002946   0.009115   0.323 0.746507
## total:taster_nameRoger Voss               0.060919   0.009051   6.731 1.70e-11
## total:taster_nameSean P. Sullivan         0.007387   0.009366   0.789 0.430292
## total:taster_nameSusan Kostrzewa         -0.040420   0.012239  -3.303 0.000958
## total:taster_nameVirginie Boone           0.057080   0.009198   6.206 5.46e-10
##                                             
## (Intercept)                              ***
## total                                    ***
## taster_nameAnna Lee C. Iijima            ** 
## taster_nameAnne Krebiehl<U+00A0>MW       ***
## taster_nameCarrie Dykes                  .  
## taster_nameChristina Pickard                
## taster_nameFiona Adams                      
## taster_nameJeff Jenssen                  ***
## taster_nameJim Gordon                       
## taster_nameJoe Czerwinski                ** 
## taster_nameKerin O<U+2019>Keefe          .  
## taster_nameLauren Buzzeo                 ** 
## taster_nameMatt Kettmann                    
## taster_nameMichael Schachner             ***
## taster_nameMike DeSimone                 ***
## taster_namePaul Gregutt                  ***
## taster_nameRoger Voss                    .  
## taster_nameSean P. Sullivan              ***
## taster_nameSusan Kostrzewa               ***
## taster_nameVirginie Boone                *  
## total:taster_nameAnna Lee C. Iijima      ** 
## total:taster_nameAnne Krebiehl<U+00A0>MW    
## total:taster_nameCarrie Dykes               
## total:taster_nameChristina Pickard       .  
## total:taster_nameFiona Adams                
## total:taster_nameJeff Jenssen               
## total:taster_nameJim Gordon              ***
## total:taster_nameJoe Czerwinski          ** 
## total:taster_nameKerin O<U+2019>Keefe    ***
## total:taster_nameLauren Buzzeo           ***
## total:taster_nameMatt Kettmann           ***
## total:taster_nameMichael Schachner       ***
## total:taster_nameMike DeSimone              
## total:taster_namePaul Gregutt               
## total:taster_nameRoger Voss              ***
## total:taster_nameSean P. Sullivan           
## total:taster_nameSusan Kostrzewa         ***
## total:taster_nameVirginie Boone          ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 2.394 on 103689 degrees of freedom
##   (26244 observations deleted due to missingness)
## Multiple R-squared:  0.3441, Adjusted R-squared:  0.3438 
## F-statistic:  1470 on 37 and 103689 DF,  p-value: < 2.2e-16
plot(total_to_points, las = 1)

coeftest(total_to_points, vcov = vcovHC(total_to_points, type = 'HC3'))
## 
## t test of coefficients:
## 
##                                            Estimate Std. Error  t value
## (Intercept)                              82.1038206  0.2677962 306.5907
## total                                     0.0937110  0.0064376  14.5568
## taster_nameAnna Lee C. Iijima             1.3078927  0.3292439   3.9724
## taster_nameAnne Krebiehl<U+00A0>MW        3.2936742  0.2844301  11.5799
## taster_nameCarrie Dykes                   1.8561851  0.8903608   2.0848
## taster_nameChristina Pickard             -7.0983976 13.4983619  -0.5259
## taster_nameFiona Adams                    1.0736169  1.4042502   0.7645
## taster_nameJeff Jenssen                   3.0272584  0.4598497   6.5831
## taster_nameJim Gordon                    -0.2108106  0.2976978  -0.7081
## taster_nameJoe Czerwinski                 1.1070085  0.3035456   3.6469
## taster_nameKerin O<U+2019>Keefe           0.6643432  0.2833427   2.3447
## taster_nameLauren Buzzeo                 -1.2851578  0.3020414  -4.2549
## taster_nameMatt Kettmann                  0.5084926  0.3138658   1.6201
## taster_nameMichael Schachner             -2.5306130  0.2857073  -8.8574
## taster_nameMike DeSimone                  3.6136711  0.5310988   6.8041
## taster_namePaul Gregutt                   2.6620068  0.2841107   9.3696
## taster_nameRoger Voss                     0.6746601  0.2764124   2.4408
## taster_nameSean P. Sullivan               2.8303483  0.2851029   9.9275
## taster_nameSusan Kostrzewa                2.3229824  0.4601286   5.0486
## taster_nameVirginie Boone                 0.9037228  0.2883349   3.1343
## total:taster_nameAnna Lee C. Iijima       0.0262449  0.0079512   3.3008
## total:taster_nameAnne Krebiehl<U+00A0>MW  0.0151001  0.0067001   2.2537
## total:taster_nameCarrie Dykes            -0.0373690  0.0210842  -1.7724
## total:taster_nameChristina Pickard        0.2468530  0.3484605   0.7084
## total:taster_nameFiona Adams             -0.0114374  0.0318312  -0.3593
## total:taster_nameJeff Jenssen            -0.0054462  0.0123327  -0.4416
## total:taster_nameJim Gordon               0.0709393  0.0071534   9.9169
## total:taster_nameJoe Czerwinski           0.0304729  0.0072150   4.2236
## total:taster_nameKerin O<U+2019>Keefe     0.0596292  0.0068802   8.6668
## total:taster_nameLauren Buzzeo            0.0477652  0.0070173   6.8068
## total:taster_nameMatt Kettmann            0.0560341  0.0072173   7.7639
## total:taster_nameMichael Schachner        0.0735145  0.0068403  10.7472
## total:taster_nameMike DeSimone           -0.0208218  0.0116606  -1.7857
## total:taster_namePaul Gregutt             0.0029464  0.0067604   0.4358
## total:taster_nameRoger Voss               0.0609190  0.0066692   9.1344
## total:taster_nameSean P. Sullivan         0.0073870  0.0068862   1.0727
## total:taster_nameSusan Kostrzewa         -0.0404203  0.0111988  -3.6094
## total:taster_nameVirginie Boone           0.0570801  0.0069268   8.2405
##                                           Pr(>|t|)    
## (Intercept)                              < 2.2e-16 ***
## total                                    < 2.2e-16 ***
## taster_nameAnna Lee C. Iijima            7.120e-05 ***
## taster_nameAnne Krebiehl<U+00A0>MW       < 2.2e-16 ***
## taster_nameCarrie Dykes                  0.0370939 *  
## taster_nameChristina Pickard             0.5989789    
## taster_nameFiona Adams                   0.4445424    
## taster_nameJeff Jenssen                  4.628e-11 ***
## taster_nameJim Gordon                    0.4788622    
## taster_nameJoe Czerwinski                0.0002655 ***
## taster_nameKerin O<U+2019>Keefe          0.0190462 *  
## taster_nameLauren Buzzeo                 2.093e-05 ***
## taster_nameMatt Kettmann                 0.1052148    
## taster_nameMichael Schachner             < 2.2e-16 ***
## taster_nameMike DeSimone                 1.022e-11 ***
## taster_namePaul Gregutt                  < 2.2e-16 ***
## taster_nameRoger Voss                    0.0146575 *  
## taster_nameSean P. Sullivan              < 2.2e-16 ***
## taster_nameSusan Kostrzewa               4.459e-07 ***
## taster_nameVirginie Boone                0.0017232 ** 
## total:taster_nameAnna Lee C. Iijima      0.0009646 ***
## total:taster_nameAnne Krebiehl<U+00A0>MW 0.0242176 *  
## total:taster_nameCarrie Dykes            0.0763363 .  
## total:taster_nameChristina Pickard       0.4786921    
## total:taster_nameFiona Adams             0.7193603    
## total:taster_nameJeff Jenssen            0.6587738    
## total:taster_nameJim Gordon              < 2.2e-16 ***
## total:taster_nameJoe Czerwinski          2.407e-05 ***
## total:taster_nameKerin O<U+2019>Keefe    < 2.2e-16 ***
## total:taster_nameLauren Buzzeo           1.003e-11 ***
## total:taster_nameMatt Kettmann           8.310e-15 ***
## total:taster_nameMichael Schachner       < 2.2e-16 ***
## total:taster_nameMike DeSimone           0.0741573 .  
## total:taster_namePaul Gregutt            0.6629637    
## total:taster_nameRoger Voss              < 2.2e-16 ***
## total:taster_nameSean P. Sullivan        0.2833977    
## total:taster_nameSusan Kostrzewa         0.0003071 ***
## total:taster_nameVirginie Boone          < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Модель, учитывающая цену построилась ужасно - логично, распредение цены сильно отличается от нормального

total_to_points <- lm(points ~ (total + price)*taster_name, wine)
summary(total_to_points)
## 
## Call:
## lm(formula = points ~ (total + price) * taster_name, data = wine)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -42.900  -1.438   0.053   1.503  10.079 
## 
## Coefficients:
##                                           Estimate Std. Error t value Pr(>|t|)
## (Intercept)                              82.182511   0.360018 228.273  < 2e-16
## total                                     0.095353   0.008490  11.231  < 2e-16
## price                                    -0.005012   0.006778  -0.739 0.459670
## taster_nameAnna Lee C. Iijima             1.432122   0.397370   3.604 0.000314
## taster_nameAnne Krebiehl<U+00A0>MW        3.125998   0.380801   8.209 2.26e-16
## taster_nameCarrie Dykes                   0.456624   1.068226   0.427 0.669045
## taster_nameChristina Pickard             -9.817506   4.932786  -1.990 0.046566
## taster_nameFiona Adams                    0.800761   2.197100   0.364 0.715513
## taster_nameJeff Jenssen                   3.052657   0.554301   5.507 3.65e-08
## taster_nameJim Gordon                    -0.260986   0.385304  -0.677 0.498184
## taster_nameJoe Czerwinski                 1.258999   0.381153   3.303 0.000956
## taster_nameKerin O<U+2019>Keefe           0.904663   0.374092   2.418 0.015596
## taster_nameLauren Buzzeo                 -1.199472   0.421306  -2.847 0.004414
## taster_nameMatt Kettmann                  0.343655   0.393705   0.873 0.382733
## taster_nameMichael Schachner             -1.840234   0.369713  -4.977 6.45e-07
## taster_nameMike DeSimone                  3.318037   0.615622   5.390 7.07e-08
## taster_namePaul Gregutt                   1.599696   0.369224   4.333 1.48e-05
## taster_nameRoger Voss                     0.142443   0.365469   0.390 0.696718
## taster_nameSean P. Sullivan               2.260183   0.374942   6.028 1.67e-09
## taster_nameSusan Kostrzewa                2.137625   0.485700   4.401 1.08e-05
## taster_nameVirginie Boone                 0.414816   0.370532   1.120 0.262924
## total:taster_nameAnna Lee C. Iijima       0.004685   0.009397   0.499 0.618101
## total:taster_nameAnne Krebiehl<U+00A0>MW  0.003948   0.008896   0.444 0.657147
## total:taster_nameCarrie Dykes            -0.040675   0.021573  -1.885 0.059368
## total:taster_nameChristina Pickard        0.143537   0.132386   1.084 0.278268
## total:taster_nameFiona Adams             -0.012993   0.044066  -0.295 0.768104
## total:taster_nameJeff Jenssen            -0.031796   0.014514  -2.191 0.028470
## total:taster_nameJim Gordon               0.034901   0.009204   3.792 0.000149
## total:taster_nameJoe Czerwinski           0.004050   0.008980   0.451 0.651985
## total:taster_nameKerin O<U+2019>Keefe     0.030812   0.008893   3.465 0.000531
## total:taster_nameLauren Buzzeo            0.031243   0.009905   3.154 0.001609
## total:taster_nameMatt Kettmann            0.042819   0.009077   4.718 2.39e-06
## total:taster_nameMichael Schachner        0.033724   0.008718   3.868 0.000110
## total:taster_nameMike DeSimone           -0.034570   0.013731  -2.518 0.011813
## total:taster_namePaul Gregutt            -0.021680   0.008672  -2.500 0.012425
## total:taster_nameRoger Voss               0.052950   0.008639   6.129 8.87e-10
## total:taster_nameSean P. Sullivan        -0.031864   0.008959  -3.557 0.000376
## total:taster_nameSusan Kostrzewa         -0.055160   0.011621  -4.747 2.07e-06
## total:taster_nameVirginie Boone           0.032243   0.008751   3.685 0.000229
## price:taster_nameAnna Lee C. Iijima       0.025783   0.006830   3.775 0.000160
## price:taster_nameAnne Krebiehl<U+00A0>MW  0.022288   0.006965   3.200 0.001375
## price:taster_nameCarrie Dykes             0.049868   0.018531   2.691 0.007122
## price:taster_nameChristina Pickard        0.225585   0.093014   2.425 0.015299
## price:taster_nameFiona Adams              0.011120   0.027454   0.405 0.685450
## price:taster_nameJeff Jenssen             0.040476   0.008168   4.955 7.23e-07
## price:taster_nameJim Gordon               0.056144   0.007103   7.905 2.71e-15
## price:taster_nameJoe Czerwinski           0.028734   0.006817   4.215 2.50e-05
## price:taster_nameKerin O<U+2019>Keefe     0.023897   0.006806   3.511 0.000446
## price:taster_nameLauren Buzzeo            0.027906   0.007365   3.789 0.000151
## price:taster_nameMatt Kettmann            0.022448   0.006835   3.284 0.001023
## price:taster_nameMichael Schachner        0.040887   0.006811   6.003 1.95e-09
## price:taster_nameMike DeSimone            0.032525   0.009088   3.579 0.000345
## price:taster_namePaul Gregutt             0.064855   0.006889   9.414  < 2e-16
## price:taster_nameRoger Voss               0.017889   0.006782   2.638 0.008347
## price:taster_nameSean P. Sullivan         0.061129   0.006989   8.746  < 2e-16
## price:taster_nameSusan Kostrzewa          0.033631   0.007844   4.288 1.81e-05
## price:taster_nameVirginie Boone           0.034319   0.006816   5.035 4.78e-07
##                                             
## (Intercept)                              ***
## total                                    ***
## price                                       
## taster_nameAnna Lee C. Iijima            ***
## taster_nameAnne Krebiehl<U+00A0>MW       ***
## taster_nameCarrie Dykes                     
## taster_nameChristina Pickard             *  
## taster_nameFiona Adams                      
## taster_nameJeff Jenssen                  ***
## taster_nameJim Gordon                       
## taster_nameJoe Czerwinski                ***
## taster_nameKerin O<U+2019>Keefe          *  
## taster_nameLauren Buzzeo                 ** 
## taster_nameMatt Kettmann                    
## taster_nameMichael Schachner             ***
## taster_nameMike DeSimone                 ***
## taster_namePaul Gregutt                  ***
## taster_nameRoger Voss                       
## taster_nameSean P. Sullivan              ***
## taster_nameSusan Kostrzewa               ***
## taster_nameVirginie Boone                   
## total:taster_nameAnna Lee C. Iijima         
## total:taster_nameAnne Krebiehl<U+00A0>MW    
## total:taster_nameCarrie Dykes            .  
## total:taster_nameChristina Pickard          
## total:taster_nameFiona Adams                
## total:taster_nameJeff Jenssen            *  
## total:taster_nameJim Gordon              ***
## total:taster_nameJoe Czerwinski             
## total:taster_nameKerin O<U+2019>Keefe    ***
## total:taster_nameLauren Buzzeo           ** 
## total:taster_nameMatt Kettmann           ***
## total:taster_nameMichael Schachner       ***
## total:taster_nameMike DeSimone           *  
## total:taster_namePaul Gregutt            *  
## total:taster_nameRoger Voss              ***
## total:taster_nameSean P. Sullivan        ***
## total:taster_nameSusan Kostrzewa         ***
## total:taster_nameVirginie Boone          ***
## price:taster_nameAnna Lee C. Iijima      ***
## price:taster_nameAnne Krebiehl<U+00A0>MW ** 
## price:taster_nameCarrie Dykes            ** 
## price:taster_nameChristina Pickard       *  
## price:taster_nameFiona Adams                
## price:taster_nameJeff Jenssen            ***
## price:taster_nameJim Gordon              ***
## price:taster_nameJoe Czerwinski          ***
## price:taster_nameKerin O<U+2019>Keefe    ***
## price:taster_nameLauren Buzzeo           ***
## price:taster_nameMatt Kettmann           ** 
## price:taster_nameMichael Schachner       ***
## price:taster_nameMike DeSimone           ***
## price:taster_namePaul Gregutt            ***
## price:taster_nameRoger Voss              ** 
## price:taster_nameSean P. Sullivan        ***
## price:taster_nameSusan Kostrzewa         ***
## price:taster_nameVirginie Boone          ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 2.191 on 96422 degrees of freedom
##   (33492 observations deleted due to missingness)
## Multiple R-squared:  0.449,  Adjusted R-squared:  0.4487 
## F-statistic:  1403 on 56 and 96422 DF,  p-value: < 2.2e-16
plot(total_to_points, las = 1)

coeftest(total_to_points, vcov = vcovHC(total_to_points, type = 'HC3'))
## 
## t test of coefficients:
## 
##                                            Estimate Std. Error  t value
## (Intercept)                              82.1825105  0.2859171 287.4348
## total                                     0.0953532  0.0064002  14.8985
## price                                    -0.0050119  0.0050147  -0.9994
## taster_nameAnna Lee C. Iijima             1.4321216  0.3378524   4.2389
## taster_nameAnne Krebiehl<U+00A0>MW        3.1259981  0.3204131   9.7561
## taster_nameCarrie Dykes                   0.4566241  0.9845022   0.4638
## taster_nameChristina Pickard             -9.8175063  5.1696952  -1.8990
## taster_nameFiona Adams                    0.8007612  1.6864911   0.4748
## taster_nameJeff Jenssen                   3.0526569  0.4516318   6.7592
## taster_nameJim Gordon                    -0.2609863  0.3112134  -0.8386
## taster_nameJoe Czerwinski                 1.2589987  0.3181000   3.9579
## taster_nameKerin O<U+2019>Keefe           0.9046631  0.3005018   3.0105
## taster_nameLauren Buzzeo                 -1.1994717  0.3294817  -3.6405
## taster_nameMatt Kettmann                  0.3436550  0.3888270   0.8838
## taster_nameMichael Schachner             -1.8402337  0.3028656  -6.0761
## taster_nameMike DeSimone                  3.3180368  0.5647031   5.8757
## taster_namePaul Gregutt                   1.5996959  0.3011177   5.3125
## taster_nameRoger Voss                     0.1424434  0.2963021   0.4807
## taster_nameSean P. Sullivan               2.2601832  0.3013580   7.5000
## taster_nameSusan Kostrzewa                2.1376248  0.5520283   3.8723
## taster_nameVirginie Boone                 0.4148158  0.3035462   1.3666
## total:taster_nameAnna Lee C. Iijima       0.0046847  0.0078668   0.5955
## total:taster_nameAnne Krebiehl<U+00A0>MW  0.0039484  0.0151395   0.2608
## total:taster_nameCarrie Dykes            -0.0406752  0.0205276  -1.9815
## total:taster_nameChristina Pickard        0.1435366  0.1332173   1.0775
## total:taster_nameFiona Adams             -0.0129930  0.0336584  -0.3860
## total:taster_nameJeff Jenssen            -0.0317962  0.0116844  -2.7213
## total:taster_nameJim Gordon               0.0349014  0.0072149   4.8374
## total:taster_nameJoe Czerwinski           0.0040503  0.0073802   0.5488
## total:taster_nameKerin O<U+2019>Keefe     0.0308118  0.0069434   4.4376
## total:taster_nameLauren Buzzeo            0.0312425  0.0077630   4.0246
## total:taster_nameMatt Kettmann            0.0428195  0.0187961   2.2781
## total:taster_nameMichael Schachner        0.0337238  0.0070810   4.7626
## total:taster_nameMike DeSimone           -0.0345703  0.0118002  -2.9296
## total:taster_namePaul Gregutt            -0.0216797  0.0066895  -3.2409
## total:taster_nameRoger Voss               0.0529505  0.0072073   7.3468
## total:taster_nameSean P. Sullivan        -0.0318642  0.0068794  -4.6318
## total:taster_nameSusan Kostrzewa         -0.0551597  0.0110395  -4.9966
## total:taster_nameVirginie Boone           0.0322430  0.0068941   4.6769
## price:taster_nameAnna Lee C. Iijima       0.0257826  0.0057106   4.5149
## price:taster_nameAnne Krebiehl<U+00A0>MW  0.0222880  0.0252428   0.8829
## price:taster_nameCarrie Dykes             0.0498685  0.0154147   3.2351
## price:taster_nameChristina Pickard        0.2255851  0.1123785   2.0074
## price:taster_nameFiona Adams              0.0111200  0.0189444   0.5870
## price:taster_nameJeff Jenssen             0.0404757  0.0113007   3.5817
## price:taster_nameJim Gordon               0.0561439  0.0057655   9.7379
## price:taster_nameJoe Czerwinski           0.0287345  0.0056349   5.0993
## price:taster_nameKerin O<U+2019>Keefe     0.0238966  0.0051647   4.6269
## price:taster_nameLauren Buzzeo            0.0279062  0.0076083   3.6679
## price:taster_nameMatt Kettmann            0.0224478  0.0285103   0.7874
## price:taster_nameMichael Schachner        0.0408871  0.0056327   7.2589
## price:taster_nameMike DeSimone            0.0325253  0.0079891   4.0712
## price:taster_namePaul Gregutt             0.0648550  0.0053154  12.2014
## price:taster_nameRoger Voss               0.0178892  0.0054163   3.3029
## price:taster_nameSean P. Sullivan         0.0611291  0.0053678  11.3881
## price:taster_nameSusan Kostrzewa          0.0336306  0.0157142   2.1401
## price:taster_nameVirginie Boone           0.0343189  0.0051770   6.6292
##                                           Pr(>|t|)    
## (Intercept)                              < 2.2e-16 ***
## total                                    < 2.2e-16 ***
## price                                    0.3175826    
## taster_nameAnna Lee C. Iijima            2.248e-05 ***
## taster_nameAnne Krebiehl<U+00A0>MW       < 2.2e-16 ***
## taster_nameCarrie Dykes                  0.6427834    
## taster_nameChristina Pickard             0.0575610 .  
## taster_nameFiona Adams                   0.6349242    
## taster_nameJeff Jenssen                  1.396e-11 ***
## taster_nameJim Gordon                    0.4016909    
## taster_nameJoe Czerwinski                7.567e-05 ***
## taster_nameKerin O<U+2019>Keefe          0.0026088 ** 
## taster_nameLauren Buzzeo                 0.0002723 ***
## taster_nameMatt Kettmann                 0.3767929    
## taster_nameMichael Schachner             1.236e-09 ***
## taster_nameMike DeSimone                 4.224e-09 ***
## taster_namePaul Gregutt                  1.084e-07 ***
## taster_nameRoger Voss                    0.6307045    
## taster_nameSean P. Sullivan              6.436e-14 ***
## taster_nameSusan Kostrzewa               0.0001079 ***
## taster_nameVirginie Boone                0.1717647    
## total:taster_nameAnna Lee C. Iijima      0.5515085    
## total:taster_nameAnne Krebiehl<U+00A0>MW 0.7942444    
## total:taster_nameCarrie Dykes            0.0475395 *  
## total:taster_nameChristina Pickard       0.2812767    
## total:taster_nameFiona Adams             0.6994779    
## total:taster_nameJeff Jenssen            0.0065045 ** 
## total:taster_nameJim Gordon              1.318e-06 ***
## total:taster_nameJoe Czerwinski          0.5831415    
## total:taster_nameKerin O<U+2019>Keefe    9.108e-06 ***
## total:taster_nameLauren Buzzeo           5.712e-05 ***
## total:taster_nameMatt Kettmann           0.0227228 *  
## total:taster_nameMichael Schachner       1.914e-06 ***
## total:taster_nameMike DeSimone           0.0033943 ** 
## total:taster_namePaul Gregutt            0.0011921 ** 
## total:taster_nameRoger Voss              2.047e-13 ***
## total:taster_nameSean P. Sullivan        3.629e-06 ***
## total:taster_nameSusan Kostrzewa         5.846e-07 ***
## total:taster_nameVirginie Boone          2.916e-06 ***
## price:taster_nameAnna Lee C. Iijima      6.343e-06 ***
## price:taster_nameAnne Krebiehl<U+00A0>MW 0.3772684    
## price:taster_nameCarrie Dykes            0.0012163 ** 
## price:taster_nameChristina Pickard       0.0447131 *  
## price:taster_nameFiona Adams             0.5572162    
## price:taster_nameJeff Jenssen            0.0003416 ***
## price:taster_nameJim Gordon              < 2.2e-16 ***
## price:taster_nameJoe Czerwinski          3.415e-07 ***
## price:taster_nameKerin O<U+2019>Keefe    3.717e-06 ***
## price:taster_nameLauren Buzzeo           0.0002447 ***
## price:taster_nameMatt Kettmann           0.4310739    
## price:taster_nameMichael Schachner       3.931e-13 ***
## price:taster_nameMike DeSimone           4.681e-05 ***
## price:taster_namePaul Gregutt            < 2.2e-16 ***
## price:taster_nameRoger Voss              0.0009574 ***
## price:taster_nameSean P. Sullivan        < 2.2e-16 ***
## price:taster_nameSusan Kostrzewa         0.0323462 *  
## price:taster_nameVirginie Boone          3.394e-11 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

После этого я решил пропробовать что-то сказать про текст отзыва, для чего импортируется еще куча библиотек

libs <- c('tidytext', 'stringr', 'tidyr', 'wordcloud', 'reshape2', 'hunspell','SnowballC', 'xtable', 'knitr', 'kableExtra')
lapply(libs, library, character.only = TRUE)
## Loading required package: RColorBrewer
## 
## Attaching package: 'reshape2'
## The following object is masked from 'package:tidyr':
## 
##     smiths
## 
## Attaching package: 'kableExtra'
## The following object is masked from 'package:dplyr':
## 
##     group_rows
## [[1]]
##  [1] "tidytext"   "lmtest"     "zoo"        "sandwich"   "colorspace"
##  [6] "rstatix"    "GGally"     "corrplot"   "ggpubr"     "caret"     
## [11] "lattice"    "tseries"    "forcats"    "stringr"    "dplyr"     
## [16] "purrr"      "readr"      "tidyr"      "tibble"     "ggplot2"   
## [21] "tidyverse"  "stats"      "graphics"   "grDevices"  "utils"     
## [26] "datasets"   "methods"    "base"      
## 
## [[2]]
##  [1] "tidytext"   "lmtest"     "zoo"        "sandwich"   "colorspace"
##  [6] "rstatix"    "GGally"     "corrplot"   "ggpubr"     "caret"     
## [11] "lattice"    "tseries"    "forcats"    "stringr"    "dplyr"     
## [16] "purrr"      "readr"      "tidyr"      "tibble"     "ggplot2"   
## [21] "tidyverse"  "stats"      "graphics"   "grDevices"  "utils"     
## [26] "datasets"   "methods"    "base"      
## 
## [[3]]
##  [1] "tidytext"   "lmtest"     "zoo"        "sandwich"   "colorspace"
##  [6] "rstatix"    "GGally"     "corrplot"   "ggpubr"     "caret"     
## [11] "lattice"    "tseries"    "forcats"    "stringr"    "dplyr"     
## [16] "purrr"      "readr"      "tidyr"      "tibble"     "ggplot2"   
## [21] "tidyverse"  "stats"      "graphics"   "grDevices"  "utils"     
## [26] "datasets"   "methods"    "base"      
## 
## [[4]]
##  [1] "wordcloud"    "RColorBrewer" "tidytext"     "lmtest"       "zoo"         
##  [6] "sandwich"     "colorspace"   "rstatix"      "GGally"       "corrplot"    
## [11] "ggpubr"       "caret"        "lattice"      "tseries"      "forcats"     
## [16] "stringr"      "dplyr"        "purrr"        "readr"        "tidyr"       
## [21] "tibble"       "ggplot2"      "tidyverse"    "stats"        "graphics"    
## [26] "grDevices"    "utils"        "datasets"     "methods"      "base"        
## 
## [[5]]
##  [1] "reshape2"     "wordcloud"    "RColorBrewer" "tidytext"     "lmtest"      
##  [6] "zoo"          "sandwich"     "colorspace"   "rstatix"      "GGally"      
## [11] "corrplot"     "ggpubr"       "caret"        "lattice"      "tseries"     
## [16] "forcats"      "stringr"      "dplyr"        "purrr"        "readr"       
## [21] "tidyr"        "tibble"       "ggplot2"      "tidyverse"    "stats"       
## [26] "graphics"     "grDevices"    "utils"        "datasets"     "methods"     
## [31] "base"        
## 
## [[6]]
##  [1] "hunspell"     "reshape2"     "wordcloud"    "RColorBrewer" "tidytext"    
##  [6] "lmtest"       "zoo"          "sandwich"     "colorspace"   "rstatix"     
## [11] "GGally"       "corrplot"     "ggpubr"       "caret"        "lattice"     
## [16] "tseries"      "forcats"      "stringr"      "dplyr"        "purrr"       
## [21] "readr"        "tidyr"        "tibble"       "ggplot2"      "tidyverse"   
## [26] "stats"        "graphics"     "grDevices"    "utils"        "datasets"    
## [31] "methods"      "base"        
## 
## [[7]]
##  [1] "SnowballC"    "hunspell"     "reshape2"     "wordcloud"    "RColorBrewer"
##  [6] "tidytext"     "lmtest"       "zoo"          "sandwich"     "colorspace"  
## [11] "rstatix"      "GGally"       "corrplot"     "ggpubr"       "caret"       
## [16] "lattice"      "tseries"      "forcats"      "stringr"      "dplyr"       
## [21] "purrr"        "readr"        "tidyr"        "tibble"       "ggplot2"     
## [26] "tidyverse"    "stats"        "graphics"     "grDevices"    "utils"       
## [31] "datasets"     "methods"      "base"        
## 
## [[8]]
##  [1] "xtable"       "SnowballC"    "hunspell"     "reshape2"     "wordcloud"   
##  [6] "RColorBrewer" "tidytext"     "lmtest"       "zoo"          "sandwich"    
## [11] "colorspace"   "rstatix"      "GGally"       "corrplot"     "ggpubr"      
## [16] "caret"        "lattice"      "tseries"      "forcats"      "stringr"     
## [21] "dplyr"        "purrr"        "readr"        "tidyr"        "tibble"      
## [26] "ggplot2"      "tidyverse"    "stats"        "graphics"     "grDevices"   
## [31] "utils"        "datasets"     "methods"      "base"        
## 
## [[9]]
##  [1] "knitr"        "xtable"       "SnowballC"    "hunspell"     "reshape2"    
##  [6] "wordcloud"    "RColorBrewer" "tidytext"     "lmtest"       "zoo"         
## [11] "sandwich"     "colorspace"   "rstatix"      "GGally"       "corrplot"    
## [16] "ggpubr"       "caret"        "lattice"      "tseries"      "forcats"     
## [21] "stringr"      "dplyr"        "purrr"        "readr"        "tidyr"       
## [26] "tibble"       "ggplot2"      "tidyverse"    "stats"        "graphics"    
## [31] "grDevices"    "utils"        "datasets"     "methods"      "base"        
## 
## [[10]]
##  [1] "kableExtra"   "knitr"        "xtable"       "SnowballC"    "hunspell"    
##  [6] "reshape2"     "wordcloud"    "RColorBrewer" "tidytext"     "lmtest"      
## [11] "zoo"          "sandwich"     "colorspace"   "rstatix"      "GGally"      
## [16] "corrplot"     "ggpubr"       "caret"        "lattice"      "tseries"     
## [21] "forcats"      "stringr"      "dplyr"        "purrr"        "readr"       
## [26] "tidyr"        "tibble"       "ggplot2"      "tidyverse"    "stats"       
## [31] "graphics"     "grDevices"    "utils"        "datasets"     "methods"     
## [36] "base"

Первым делом, считается количество вхождений слова в каждый отзыв

superwine <- wine %>%
  filter(str_detect(description, "^[^>]+[A-Za-z\\d]") | description !="") 
superwine <- tibble(id_review = as.numeric(superwine$...1) , text_review = superwine$description, is_good = superwine$description >= 92)
superwine <- superwine %>%  unnest_tokens(word, text_review) %>% na.omit()
superwine

Далее была построена гистограмма для топа слов по всем отзывам. Ожидаемо, чаще всего встречаются союзы, предлоги, артикли и прочие служебные части речи. Их осмысленного, понятное дело часто встречается слово wine и характеристики вина - таннинность, кислотность, общее впечатление.

superwine %>% 
  count(word, sort = TRUE) %>% 
  filter(n > 20000) %>% 
  mutate(word = reorder(word, n)) %>% 
  ggplot(aes(word, n)) + 
  geom_col() + 
  xlab(NULL) + 
  coord_flip() +
  ggtitle("Plot top words count")

Далее все вино было поделено на 2 категории - с оценкой ниже и выше 92. Собственно, хорошим я буду называть вино, оцененнок выше 92 баллов. Оценка взята не с потолка и даже не p-value, а банально из личного опыта. Были построены гистограммы для наиболее частых слов в хорошем и плохом вине. Там много пересечений, большая часть снова служебные части речи и очень хорошо заметно, что отзывы о хорошем вине длиннее. При этом в более низкорейтиговом вине чаще появляются характеристики и описания, а высокорейтинговое оценивают ощущениями

superwine_counts <- superwine %>% group_by( word, is_good) %>%summarise (count = n())
## `summarise()` has grouped output by 'word'. You can override using the
## `.groups` argument.
superwine_counts %>% 
  group_by(is_good) %>% 
  top_n(25, count) %>%
  ungroup() %>%
  mutate(word = reorder(word, count)) %>%
  ggplot(aes(y = word, x = count, fill = is_good)) + 
  geom_col(show.legend = FALSE) + 
  facet_wrap(~is_good, scales = "free_y") + 
  labs(y = "Contribution to Sentiment", x = NULL) +
  ggtitle("Plot top words into categories")

Было построено сравнительное облако слов о хорошем и плохом вине. Чем больше на нем слово, тем чаще оно появляется в соответсвующих отзывах

superwine %>% 
  count(word, is_good, sort = TRUE) %>% 
  acast(word ~ is_good, value.var = "n", fill = 0) %>% 
  comparison.cloud(colors = c("gray20", "gray80"), max.words = 100)

Далее было отобрано 100 самых часто встречающися слов по категориям хорошего и плохого вина и для этих слов сделан тест фишера (проверялась зависимость переменных наличие слова и статус отзыва - хороший или не очень)

most_freq <- superwine_counts %>% 
  group_by(is_good) %>% 
  top_n(100, count) %>%
  ungroup()
most_freq <- most_freq %>% distinct(word)
pval_freqs <- c()
for (pattern in most_freq$word){
  my_mat <- c(filter(superwine_counts, word==pattern & is_good == T)[1, 'count'],
    filter(superwine_counts, word==pattern & is_good == F)[1, 'count'],
    sum(filter(superwine_counts, word!=pattern & is_good == T)[, 'count']),
    sum(filter(superwine_counts, word!=pattern & is_good == F)[, 'count']))
  my_mat <- unlist(my_mat, use.names=FALSE)
  my_mat <- matrix(my_mat,nrow=2,ncol=2,byrow=TRUE)
  my_mat[is.na(my_mat)] = 0
  cur_pva <- fisher.test(my_mat, simulate.p.value = T, B = 10000)$p.value
  pval_freqs <- append(pval_freqs, cur_pva)
}

Был построен график -log2 p-value (поправленных Холмом). На нем можно увидеть, ккие слова ассоциированы с какой категорией отзывов. В среднем, плохие отзывы более числовые и включают слова-описания вкуса вина, хорошие же об эмоциях и красном вишневом вине.А столбики 2 цветов - это, скорее всего, артефакт, вызванный ну очень уж разными размерами отзывов.

pval_freqs <- p.adjust(pval_freqs, method = "holm")
pval_table <- data.frame(word = most_freq$word, b = -1*log(pval_freqs, base = 2))
pval_table <- as_tibble(pval_table)
most_freq <- superwine_counts %>% 
  group_by(is_good) %>% 
  top_n(100, count) %>%
  ungroup()
pval_table = left_join(pval_table, most_freq, by = c("word" = "word"))
pval_table %>%
  top_n(50, b) %>%
  ggplot(aes(y = word, x = b, fill = is_good)) + 
  geom_col(show.legend = T) + 
  labs(y = "", x = NULL) +
  ggtitle("-log2 pvalues") +
  ggtitle("Plot of top words pvalues")

Та часть, которая не получилась - здесь должна была быть модель предсказатель рейтинга по отзыву на основе реккурентных слоев, но моего компа не хватило даже на токенизацию небольшой подвыборки. Если бы был питон/видеокарта/нормальные мозги запилил бы реккурентную нейронку с кучей параметров (нет. или да. надо будет попробовать на досуге).

Ну вот как-то так. А я пошел проверять на практике предположение о том, что большие отзывы связаны с хорошим вином. И что хорошее вино стоит дорого (плакала моя зарплата(((((. И вам желаю того же - чем больше данных, тем точнее статистика.